home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Snippets / PNL Libraries / MyHistory.p < prev    next >
Encoding:
Text File  |  1996-08-21  |  6.3 KB  |  246 lines  |  [TEXT/CWIE]
  1. unit MyHistory;
  2.  
  3. { Edit history}
  4. {  9 Dec 95    pnl    Original}
  5. { 8 Apr 96    jc        Add bits for marking which downstream servers were offered this message }
  6. { 9 Apr 96    jc        Adjust ReadEntry to account for longer EntryRecord }
  7. {11 Apr 96    jc        Fix bug in markMsgSent (reading too many bytes & clobbering data on write }
  8. {14 Apr 96    jc        Added markMsgNotSent }
  9. {25 May 96    jc        Added HistoryAfterStep }
  10.  
  11. interface
  12.  
  13.     uses
  14.         Types, Files;
  15.  
  16.     const
  17.         H_Null = $12345678;
  18.         H_FromStart = $80000000;
  19.  
  20.     function HistoryCreate (var fs: FSSpec): OSErr;
  21. { You should create the file before calling this using FSpCreate.  Any existing data will be destroyed. }
  22.     function HistoryOpen (var fs: FSSpec; var refnum: longint): OSErr;
  23.     function HistoryFlush (refnum: longint): OSErr;
  24.     function HistoryClose (refnum: longint): OSErr;
  25.     function HistoryAdd (refnum: longint; data: Str255): OSErr;
  26.     function HistoryAfter (refnum: longint; time: longint; var id: longint): OSErr;
  27.     function HistoryAfterStep(refnum: longint; time: longint; var id: longint; var maxtime: integer): OSErr;
  28.     function HistoryNext (refnum: longint; var id: longint; var time: longint; var offered: longint; var data: Str255): OSErr;
  29.     function HistoryExpire (refnum: longint; time: longint): OSErr;
  30.     function msgSentP(offered: longint; idx: integer): boolean;
  31.     procedure markMsgSent(refnum: longint; pos: longint; idx: integer);
  32.     procedure markMsgNotSent(refnum: longint; pos: longint; idx: integer);
  33. implementation
  34.  
  35.     uses
  36.         Errors, OSUtils, 
  37.         MyFileSystemUtils, MyMemory, MyMathUtils;
  38.  
  39. { File format: }
  40. { sequence of entries }
  41. { Entry format: }
  42. { time:longint }
  43. { offered: longint }
  44. { data:PString }
  45. { zero:byte }
  46.  
  47. {$PUSH}
  48. {$ALIGN MAC68K}
  49.  
  50.     const
  51.         EROverhead = 4+4+1;            { this must be adjusted to match the position of the 1st byte of Data in the HistoryRecord }
  52.     type
  53.         HistoryRecord = record
  54.             time: longint;                    { time message added }
  55.             offered: longint;                { bit mask of servers offered this message }
  56.             data: Str255;                    { message ID }
  57.             zero: byte;
  58.         end;
  59.     
  60. {$ALIGN RESET}
  61. {$POP}
  62.  
  63.     function HistoryCreate (var fs: FSSpec): OSErr;
  64.         var
  65.             err, oerr: OSErr;
  66.             rn: integer;
  67.     begin
  68.         err := FSpOpenDF(fs, fsRdWrPerm, rn);
  69.         if err = noErr then begin
  70.             err := SetEOF(rn, 0);
  71.             oerr := FSClose(rn);
  72.             if err = noErr then
  73.                 err := oerr;
  74.         end;
  75.         HistoryCreate := err;
  76.     end;
  77.  
  78.     function HistoryOpen (var fs: FSSpec; var refnum: longint): OSErr;
  79.         var
  80.             err, junk: OSErr;
  81.             rn: integer;
  82.     begin
  83.         err := FSpOpenDF(fs, fsRdWrPerm, rn);
  84.         if err = noErr then begin
  85.             if err <> noErr then begin
  86.                 junk := FSClose(rn);
  87.             end;
  88.         end;
  89.         refnum := rn;
  90.         if err <> noErr then begin
  91.             refnum := H_Null;
  92.         end;
  93.         HistoryOpen := err;
  94.     end;
  95.  
  96.     function HistoryFlush (refnum: longint): OSErr;
  97.         var
  98.             err: OSErr;
  99.             pb: ParamBlockRec;
  100.     begin
  101.         pb.ioRefNum := refnum;
  102.         err := PBFlushFileSync(@pb);
  103.         HistoryFlush := err;
  104.     end;
  105.  
  106.     function HistoryClose (refnum: longint): OSErr;
  107.         var
  108.             err: OSErr;
  109.     begin
  110.         if refnum <> H_Null then begin
  111.             err := FSClose(refnum);
  112.         end;
  113.         HistoryClose := err;
  114.     end;
  115.  
  116.     function HistoryAdd (refnum: longint; data: Str255): OSErr;
  117.         var
  118.             err: OSErr;
  119.             er: HistoryRecord;
  120.     begin
  121.         MFill(@er, SizeOf(er), 0);
  122.         GetDateTime(er.time);
  123.         er.data := data;
  124.         er.offered := 0;
  125.         err := MyFSWriteAt(refnum, fsFromLEOF, 0, EROverhead + length(data), @er);
  126.         HistoryAdd := err;
  127.     end;
  128.  
  129.     function ReadEntry (refnum: longint; var pos: longint; var entry: HistoryRecord): OSErr;
  130.         var
  131.             err: OSErr;
  132.     begin
  133.         err := MyFSReadAt(refnum, pos, EROverhead, @entry);        { read enough of the record to get string length }
  134.         if err = noErr then begin
  135.             err := MyFSReadAt(refnum, pos, EROverhead + length(entry.data), @entry); { now read entire record }
  136.         end;
  137.         if err = noErr then begin
  138.             pos := pos + EROverhead + length(entry.data);
  139.         end;
  140.         ReadEntry := err;
  141.     end;
  142.  
  143.     function HistoryAfter (refnum: longint; time: longint; var id: longint): OSErr;
  144.         var
  145.             err: OSErr;
  146.             pos: longint;
  147.             entry: HistoryRecord;
  148.     begin
  149.         pos := 0;
  150.         repeat
  151.             id := pos;
  152.             err := ReadEntry(refnum, pos, entry);
  153.         until (err <> noErr) or (entry.time >= time);
  154.         HistoryAfter := err;
  155.     end;
  156.  
  157.     function HistoryAfterStep(refnum: longint; time: longint; var id: longint; var maxtime: integer): OSErr;
  158.         var
  159.             err: OSErr;
  160.             pos: longint;
  161.             entry: HistoryRecord;
  162.             start, now: longint;
  163.     begin
  164.         pos := id;
  165.         GetDateTime(start);
  166.         repeat
  167.             id := pos;
  168.             err := ReadEntry(refnum, pos, entry);
  169.             GetDateTime(now);
  170.         until (err <> noErr) or (entry.time >= time) or ((start+maxtime)<now);
  171.         if  ((start+maxtime)<now) then maxtime := -maxtime;        { let caller know it timed out }
  172.         HistoryAfterStep := err;
  173.     end;
  174.  
  175.     function HistoryNext (refnum: longint; var id: longint; var time: longint; var offered: longint; var data: Str255): OSErr;
  176.         var
  177.             err: OSErr;
  178.             entry: HistoryRecord;
  179.     begin
  180.         err := ReadEntry(refnum, id, entry);
  181.         time := entry.time;
  182.         offered := entry.offered;
  183.         data := entry.data;
  184.         HistoryNext := err;
  185.     end;
  186.  
  187.     function HistoryExpire (refnum: longint; time: longint): OSErr;
  188.         var
  189.             err: OSErr;
  190.             src, dst, len, cnt: longint;
  191.             buffer: packed array[1..8192] of Byte;
  192.     begin
  193.         err := HistoryAfter(refnum, time, src);
  194.         if err = noErr then begin
  195.             err := GetEOF(refnum, len);
  196.             if err = noErr then begin
  197.                 len := len - src;
  198.                 dst := 0;
  199.                 while (err = noErr) & (len > 0) do begin
  200.                     cnt := Min(len, SizeOf(buffer));
  201.                     err := MyFSReadAt(refnum, src, cnt, @buffer);
  202.                     if err = noErr then begin
  203.                         err := MyFSWriteAt(refnum, fsFromStart, dst, cnt, @buffer);
  204.                     end;
  205.                     src := src + cnt;
  206.                     dst := dst + cnt;
  207.                     len := len - cnt;
  208.                 end;
  209.             end;
  210.         end else if err = eofErr then begin
  211.             err := SetEOF(refnum, 0);
  212.         end;
  213.         HistoryExpire := err;
  214.     end;
  215.  
  216.     function msgSentP(offered: longint; idx: integer): boolean;
  217.     begin
  218.         msgSentP := BTst(offered, idx);
  219.     end;
  220.  
  221.     procedure markMsgSent(refnum: longint; pos: longint; idx: integer);
  222.         var
  223.             err: OSErr;
  224.             entry: HistoryRecord;
  225.     begin
  226.         err := MyFSReadAt(refnum, pos, EROverhead, @entry);
  227.         if err = noErr then begin
  228.             BSet(entry.offered, idx);
  229.             err := MyFSWriteAt(refnum, fsFromStart, pos, EROverhead, @entry);
  230.         end;
  231.     end;
  232.         
  233.     procedure markMsgNotSent(refnum: longint; pos: longint; idx: integer);
  234.         var
  235.             err: OSErr;
  236.             entry: HistoryRecord;
  237.     begin
  238.         err := MyFSReadAt(refnum, pos, EROverhead, @entry);
  239.         if err = noErr then begin
  240.             BClr(entry.offered, idx);
  241.             err := MyFSWriteAt(refnum, fsFromStart, pos, EROverhead, @entry);
  242.         end;
  243.     end;
  244.         
  245. end.
  246.